home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tfdd.com / STRWRITE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-13  |  2.4 KB  |  97 lines
  1. (******************************************************************************
  2.  
  3.                                 UNIT  STRWRITE
  4.  
  5.  
  6. -------------------------------------------------------------------------------
  7. Philippe Ranger  (514) 274 4653
  8. First version  26-6-90          Present version 13-7-90
  9. -------------------------------------------------------------------------------
  10. SPECIFICATION
  11.    Defines a class of TFDD, strWriteC, and declares, initializes and opens one
  12.       instance, sw (text file is sw.t).
  13.    Writes to strWriteC.t are stored up to 255 chars, and retrieved thru func-
  14.       tion strWriteC.res
  15.  
  16. NOTE The initial underline indicates a class-private field.
  17. ******************************************************************************)
  18.  
  19. UNIT strWrite;
  20.  
  21. INTERFACE
  22.  
  23. USES tfdd;
  24.  
  25. TYPE
  26.    strWriteC = object (tfddC)
  27.       _s: string;
  28.       function res: string;
  29.          (*Returns total write since last call of res or init*)
  30.       constructor init
  31.       end;
  32.  
  33. VAR  sw: strWriteC;
  34.  
  35. IMPLEMENTATION
  36.  
  37. USES crt, dos;
  38.  
  39. CONST errorValue = 255;
  40.  
  41. {$F+}
  42.  
  43. PROCEDURE initialize; BEGIN  sw.init  END;
  44.  
  45.  
  46. FUNCTION strWriteC.res: string;   (*Returns _s and nulls _s*)
  47. BEGIN
  48.    res := _s;
  49.    _s := ''
  50. END;
  51.  
  52.  
  53.  
  54. FUNCTION write2str (var t: textRec): integer;
  55. (*=============================================================================
  56. PRE t open for output only;
  57. -------------------------------------------------------------------------------
  58. POST Device write added to _s, if within limit of 255 for length(s); any
  59.    excedent returns 255 (test through IOresult).
  60. =============================================================================*)
  61.  
  62. VAR
  63.    selfp: ^strWriteC;
  64.    p: byte;
  65.  
  66. BEGIN
  67. with t do begin
  68.    write2str := 0;
  69.    move (userData, selfp, sizeof(selfp));
  70.    with selfp^ do begin
  71.       if length(_s) + bufPos > 255 then begin
  72.          write2str := 255;
  73.          bufPos := 255 - length(_s);
  74.          if length(_s) = 255 then EXIT
  75.          end;
  76.       p := length(_s) + 1;
  77.       inc (_s[0], bufPos);
  78.       move (bufPtr^[0], _s[p], bufPos)
  79.       end;
  80.    bufPos := 0
  81.    end
  82. END;  (*write2str*)
  83.  
  84.  
  85. CONSTRUCTOR strWriteC.init;
  86. BEGIN
  87.    tfddC.init;
  88.    textRec(t).inoutFunc := @write2str;                           (*on principle*)
  89.    textRec(t).flushFunc := @write2str;
  90.               (*Flush seems to be the only function actually called for writes*)
  91.    _s := '';
  92.    rewrite (t)
  93. END;
  94.  
  95.  
  96. BEGIN INITIALIZE END.
  97.